home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 3: Developer Tools / Linux Cubed Series 3 - Developer Tools.iso / devel / lang / lisp / gcl-1.000 / gcl-1 / gcl-1.0 / c / num_rand.c < prev    next >
Encoding:
C/C++ Source or Header  |  1994-05-07  |  3.0 KB  |  159 lines
  1. /*
  2.  Copyright (C) 1994 M. Hagiya, W. Schelter, T. Yuasa
  3.  
  4. This file is part of GNU Common Lisp, herein referred to as GCL
  5.  
  6. GCL is free software; you can redistribute it and/or modify it under
  7. the terms of the GNU LIBRARY GENERAL PUBLIC LICENSE as published by
  8. the Free Software Foundation; either version 2, or (at your option)
  9. any later version.
  10.  
  11. GCL is distributed in the hope that it will be useful, but WITHOUT
  12. ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
  13. FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Library General Public 
  14. License for more details.
  15.  
  16. You should have received a copy of the GNU Library General Public License 
  17. along with GCL; see the file COPYING.  If not, write to the Free Software
  18. Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  19.  
  20. */
  21.  
  22. /*
  23.     Random numbers
  24. */
  25.  
  26. #include "include.h"
  27. #include "num_include.h"
  28.  
  29. #ifdef AOSVS
  30.  
  31. #endif
  32.  
  33. object
  34. rando(x, rs)
  35. object x, rs;
  36. {
  37.     enum type tx;
  38.     object z;
  39.     double d;
  40.     
  41.     tx = type_of(x);
  42.     if (number_compare(x, small_fixnum(0)) != 1)
  43.         FEwrong_type_argument(TSpositive_number, x);
  44.     d = (double)(rs->rnd.rnd_value>>1) / (4294967296.0/2.0);
  45.     d = number_to_double(x) * d;
  46.     if (tx == t_fixnum) {
  47.         z = make_fixnum((int)d);
  48.         return(z);
  49.     } else if (tx == t_bignum) {
  50.         z = double_to_integer(d);
  51.         return(z);
  52.     } else if (tx == t_shortfloat) {
  53.         z = alloc_object(t_shortfloat);
  54.         sf(z) = (float)d;
  55.         return(z);
  56.     } else if (tx == t_longfloat) {
  57.         z = alloc_object(t_longfloat);
  58.         lf(z) = d;
  59.         return(z);
  60.     } else
  61.         FEerror("~S is not an integer nor a floating-point number.",
  62.             1, x);
  63. }
  64.  
  65. object
  66. make_random_state(rs)
  67. object rs;
  68. {
  69.         object z;
  70. #ifdef AOSVS
  71.  
  72. #endif
  73.  
  74.     if (rs == Cnil) {
  75.         z = alloc_object(t_random);
  76.         z->rnd.rnd_value = symbol_value(Vrandom_state)->rnd.rnd_value;
  77.         return(z);
  78.     } else if (rs == Ct) {
  79.         z = alloc_object(t_random);
  80. #ifdef UNIX
  81.         z->rnd.rnd_value = time(0);
  82. #endif
  83. #ifdef AOSVS
  84.  
  85.  
  86.  
  87.  
  88. #endif
  89.         return(z);
  90.     } else if (type_of(rs) != t_random)
  91.            FEwrong_type_argument(Srandom_state, rs);
  92.     else {
  93.         z =alloc_object(t_random);
  94.         z->rnd.rnd_value = rs->rnd.rnd_value;
  95.         return(z);
  96.     }
  97. }
  98.  
  99. advance_random_state(rs)
  100. object rs;
  101. {
  102.     rs->rnd.rnd_value
  103.     = rs->rnd.rnd_value
  104.     + (rs->rnd.rnd_value<<2)
  105.     + (rs->rnd.rnd_value<<17)
  106.     + (rs->rnd.rnd_value<<27);
  107. }
  108.  
  109.  
  110. Lrandom()
  111. {
  112.     int j;
  113.         object x;
  114.     object rs;
  115.     
  116.     j = vs_top - vs_base;
  117.     if (j == 1)
  118.         vs_push(symbol_value(Vrandom_state));
  119.     check_arg(2);
  120.     check_type_random_state(&vs_base[1]);
  121.     advance_random_state(vs_base[1]);
  122.     x = rando(vs_base[0], vs_base[1]);
  123.     vs_top = vs_base;
  124.     vs_push(x);
  125. }
  126.  
  127. Lmake_random_state()
  128. {
  129.     int j;
  130.     object x;
  131.  
  132.     j = vs_top - vs_base;
  133.     if (j == 0)
  134.         vs_push(Cnil);
  135.     check_arg(1);
  136.     x = make_random_state(vs_head);
  137.     vs_top = vs_base;
  138.     vs_push(x);
  139. }
  140.  
  141. Lrandom_state_p()
  142. {
  143.     check_arg(1);
  144.     if (type_of(vs_pop) == t_random)
  145.         vs_push(Ct);
  146.     else
  147.         vs_push(Cnil);
  148. }
  149.  
  150. init_num_rand()
  151. {
  152.         Vrandom_state = make_special("*RANDOM-STATE*",
  153.                      make_random_state(Ct));
  154.  
  155.     make_function("RANDOM", Lrandom);
  156.     make_function("MAKE-RANDOM-STATE", Lmake_random_state);
  157.     make_function("RANDOM-STATE-P", Lrandom_state_p);
  158. }
  159.